00010		SUBROUTINE PT2
00100		DATA QLINE/150.0/,HX/2./,ZL/2./,ZM/-1.5/
00200	C  QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00300	
00400		COMMON /SF/KL,RT,KP,STFSZ,NAMX
00500		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(200)
00700		COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
00800		1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1)
00900		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01000		1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,IV(80)),(NDPY,IV(81))
01200	CC	CALL IFILE(1,'PX')
01300	103	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01400	102	FORMAT(A5)
01500		TYPE 103
01600		ACCEPT 102,NAMX
01650		IF(NAMX.EQ.' ')GO TO 102
01700		IF(LOOKF(NAMX).GE.0)GO TO 88
01800		TYPE 88,NAMX
01900		ACCEPT 102,L
02000		IF(L.EQ.'N')GO TO 103
02100	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
02200	5	FORMAT(F,I)
02210		IF(RS.NE.'OLD')GO TO 2000
02220		CALL GETFIL('PARTS')
02240		CALL FASTIN(RSTFAC,128)
02250		CALL FASTIN(KPN,JJ2)
02260		CALL FASTIN(Q,JPQ)
02300	CC	READ(1),L,LL,
02400	CC	1(PN(N),N=1,L+1),(Q(N),N=1,LL-1),J,RSTJ2,J,J,RSTFAC,STFF,IV,STFF
02410	2000	TYPE 144
02440	144	FORMAT(' STAFF SIZE, TRANSP.  '$)
02470		ACCEPT 5,RSTJ2,LL
02485		IF(RSTJ2.EQ.0)RSTJ2=.9
02510		L=JJ2-2
02515		TR=LL
02520		IF(LL.NE.0)CALL TRNSP(L,TR)
02600		I=L
02700		KK=1
02800	CC	JJ=0
02900	CC	DO 7 K=1,L
03000	CC	N=PN(K)
03100	CC	IF(Q(N+1).NE.4)GO TO 7
03200	CC	JJ=JJ+1
03300	C  FOUND A BAR LINE
03400	CC	RN(JJ)=Q(N+3)
03500	CC7	CONTINUE
03600	CC	ENDLN=RN(JJ)
03650		ENDLN=ENDL(JJ)
03675	C  FUNCTION ENDL(JJ) (IN FAIL) DOES ALL ABOVE
03700	
03710		NA=1000
03750		N=0
03820		TYPE 90
03840		RA=0
03860	90	FORMAT(' NUMBER OF BARS PER LINE'/)
03870		ZLINE=QLINE
03900	9	KL=0
04000		XLINE=ZLINE
04100		J=0
04150		LL=0
04200		DO 8 K=1,JJ
04300		IF(RN(K).LT.XLINE)GO TO 8
04400		KP=K-KL
04500	C  NUMBER OF BARS, THIS LINE
04600	CC	TYPE 89,KP
04700		KL=K
04800		J=J+1
04810		IF(IV(J).NE.KP)LL=-1
04820		IV(J)=KP
04900		XLINE=RN(K)+ZLINE
05000		IF(ENDLN-XLINE.LT.80.)XLINE=ENDLN
05100	8	CONTINUE
05110		IF(LL)TYPE 108,RA,(IV(K),K=1,J)
05115		IF(RT)GO TO 105
05120	108	FORMAT(F6.2,8(3I3,1X))
05150	CC	TYPE 108
05160	CC108	FORMAT(/)
05200	CC89	FORMAT('+',I3,$)
05205		IF(J.GT.NA)GO TO 107
05210		IF(N.EQ.0)GO TO 105
05220	C  SKIP IF FIRST TIME
05230		IF(N.NE.KP)GO TO 106
05235		IF(J.EQ.NA)GO TO 105
05240	106	RT=.05
05260	C SHRINK OR EXPAND?
05270		RA=RA+RT
05280		ZLINE=QLINE*RS/RA
05285	CC	IF(RA.GT.J)GO TO 107
05290		GO TO 9
05300	107	FORMAT(' CAN''T DO IT!')
05310		TYPE 107
05400	105	TYPE 104,J
05500	104	FORMAT(I4,' LINES - OR TYPE N1, N2 --'$)
05600		ACCEPT 5,RA,N
05700		IF(RA.EQ.0)GO TO 11
05800		IF(ZLINE.EQ.QLINE)RS=J
05820		NA=RA
05825		RT=NA-RA
05827		IF(RT)GO TO 109
05830		RA=RA-.6
05840	C  CHECK THIS ↑↑↑ NUMBER!
05850		IF(N.EQ.0)GO TO 90
05900	109	ZLINE=QLINE*RS/RA
06000		GO TO 9
06100	
06200	11	RA=0
06250		XLINE=ZLINE
06300		CLEF=-99
06400		JSLUR=0
06500		SIG=CLEF
06600	100	KL=1
06700		KP=1
06800		RT=2
06900		J=KK
07000		HGT=HX*2.
07100	
07200		DO 1 K=KK,I
07300		N=KPN(K)
07400		IF(Q(N+1).NE.4)GO TO 1
07500	CC	IF(Q(N).GT.2)GO TO 1
07600		IF(Q(N+3).LT.XLINE)GO TO 1
07700	C  FOUND LAST BAR LINE.
07800		RX=0
07900	3	JJ=KP
08000	C PUTS IN STAFF
08100		RS=3.
08200		IF(RT.NE.0)GO TO 331
08300	C NEXT FOR BOTTOM STAFF.  PUTS IN SPACER.
08400		RS=6.
08500		R8=2.45
08600	331	CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,R8)
08700		HGT=HGT-HX
08800		IF(XLINE.EQ.ZLINE)GO TO 33
08900		IF(XLINE.LT.ENDLN)GO TO 6
08910		IF(RT.EQ.0)GO TO 6
09000		RX=RT
09100		RT=0
09200		CALL STAFF(6.,8.,0,0,0,0,1.,2.45)
09300	C  PUTS IN SPACER
09400		RT=RX
09500	6	IF(JSLUR.EQ.0)GO TO 333
09600		CALL STAFF(5.,5.,0,Q(JSLUR),Q(JSLUR+1),11.5,Q(JSLUR+3),0)
09700		JSLUR=0
09800	333	IF(CLEF.EQ.-99)GO TO 33
09900	C  ONLY STAFF FOR FIRST LINE AT TOP.
10000		RX=10.*RSTJ2
10100	C  THE SPACER
10200		CALL STAFF(3.,3.,1.,0,CLEF,0,0,0)
10300		IF(SIG.EQ.-99)GO TO 33
10400		RS=4.
10500		R5=SIG
10600		RX=CLEF
10700		IF(R5.LT.50)GO TO 332
10800		RX=IFIX((R5+50.)/100.)
10900		R5=R5-RX*100.
11100	C  CLEF+SIG
11200	332	CALL STAFF(RS,17.,11.0*RSTJ2,0,R5,RX,0,0)
11300		RX=12.*RSTJ2
11400	
11500	33	R4=RA
11600		R5=Q(N+3)
11700		RS=0
11800		R7=RT
11900		R8=RX
12000		R9=200.
12100		LL=0
12200		L=K-J+1
12300		CALL PTMOVE(Q,KPN(J))
12400		RA=R5
12500		KB=KL
12600		DO 30 NA=KK,K
12700		KWDS(KP)=KB
12800		KP=KP+1
12900		JK=KPN(NA)
13000		R=Q(JK+1)
13100		IF(R.NE.5)GO TO 35
13200		IF(Q(JK+6).LT.199.)GO TO 30
13300	C CATCHES END OF SLUR
13400		Q(JK+6)=201.
13500		JSLUR=JK+4
13600	C  TO PUT SLUR ON NEXT LINE.
13700		GO TO 30
13800	35	IF(R.NE.2)GO TO 36
13900		IF(Q(JK).LT.6.)GO TO 30
14000	CC	RR=Q(IFIX(PN(NA-1))+3)
14100		RR=RIGHT(NA,-1)
14200		IF(RR.GE.199.)RR=RX
14300	CC	Q(JK+3)=RR-1.6*RSTJ2+(Q(IFIX(PN(NA+1))+3)-RR)/2.
14400		Q(JK+3)=RR-1.6*RSTJ2+(RIGHT(NA,1)-RR)/2.
14500	C  FUNCTION 'RIGHT' FINDS RIGHT ITEMS FOR CENTERING.
14600	C CENTERS WHOLE REST
14700		GO TO 30
14800	36	IF(R.NE.3)GO TO 34
14900		RR=Q(JK+5)
15000		IF(Q(JK).LT.3)RR=0
15100		CLEF=RR
15200		GO TO 30
15300	34	IF(R.NE.17)GO TO 37
15400		SIG=Q(JK+5)
15500		IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
15600	C  CLEF # IN P6 WITH KEY SIGS.
15700	C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
15800	37	IF(R.GE.33)Q(JK+1)=R/11.
15900	30	KB=KPN(NA+1)-KPN(NA)+KB
16000	
16100	CC	DO 31 NA=IFIX(PN(KK)),IFIX(PN(K+1)-1.)
16200	CC	RN(KL)=Q(NA)
16300	CC31	KL=KL+1
16400	CC	KK=K+1
16410		CALL PSHFT(KK,K)
16500		RS=RT
16600		LL='J'
16700		R4=0
16800		R5=200
16900		NA=L
17000		L=KP-JJ
17100		CALL PTMOVE(RN,KWDS(JJ))
17200		IF(K.EQ.I)GO TO 2
17300		L=NA
17400		J=K+1
17500	C  SO IT DOESN'T GO THRU ALL DATA
17600		RT=RT-1
17700		XLINE=RA+ZLINE
17800		IF(ENDLN-XLINE.LT.80.)XLINE=ENDLN
17900	10	IF(KL.GT.1700.OR.KP.GT.190.OR.RT)GO TO 2
18000	1	IF(K.EQ.I)GO TO 3
18100	CC2	L=KP
18200	CC	KWDS(KP+1)=KB
18250	2	KWDS(KP)=KB
18300		J=1
18400	CC	CALL OFILE(1,NAMX)
18500	CC	LL=KWDS(L+1)
18510		JJ2=KP+1
18548		JPQ=KB
18567	C  WRITES 1 EXTRA WORD
18600	CC2929	WRITE(1),L,LL,
18700	CC	1(KWDS(N),N=1,L+1),(RN(N),N=1,LL-1),J,J,J,J,RSTFAC,STFF,
18750	CC	1 (Q(N),N=1,78),STFF
18760		CALL PUTFIL(NAMX)
18769		LCNT=0
18773		NDPY=0
18778		CALL FASTOU(RSTFAC,128)
18784		CALL FASTOU(KWDS,JJ2)
18790		CALL FASTOU(RN,JPQ)
18800		TYPE 101,NAMX
18900	101	FORMAT(1XA5)
19000		IF(KK.GE.I)CALL EXIT
19100		NAMX=NAMX+2
19200		CALL FINFIL
19300		GO TO 100
19400		END
19500	
19600	CC	SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
19700	CC	COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
19800	CC	COMMON /PTR/PWDS(250),L,LL,I,IX
19900	CC	PWDS(KP)=KL
20000	CC	KP=KP+1
20100	CC	RN(KL)=P0
20200	CC	RN(KL+1)=P1
20300	CC	RN(KL+2)=RT
20400	CC	RN(KL+3)=P3
20500	CC	RN(KL+4)=P4
20600	CC	RN(KL+5)=P5
20700	CC	IF(P0.LT.4.)GO TO 1
20800	CC	RN(KL+6)=P6
20900	CC	IF(P0.LT.5)GO TO 1
21000	CC	RN(KL+7)=P7
21100	CC	IF(P0.LT.6)GO TO 1
21200	CC	RN(KL+8)=P8
21300	CC1	KL=KL+P0+3.
21400	CC	END
21500	
21600	CC	FUNCTION RIGHT(NA,J)
21700	CC	COMMON /PX/PN(1800) /Q/Q(9000)
21800	CC	K=NA+J
21900	C  J IS EITHER +1 OR -1
22000	CC1	L=PN(K)
22100	CC	IF(Q(L+1).NE.16)GO TO 2
22200	CC	K=K+J
22300	CC	GO TO 1
22400	CC2	RIGHT=Q(L+3)
22500	CC	END